home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PBLIB1
/
UNITS
/
OBJHOLD.INC
< prev
next >
Wrap
Text File
|
1994-04-30
|
6KB
|
243 lines
{SECTION HOLD_object }
CONSTRUCTOR HOLD_object.init(n : HOLD_NdxType);
var l : longint;
i : HOLD_NdxType;
begin
MaxEntries := n;
ArrHighVal := 0;
comment := '';
STRA_object.init(n);
l := sizeof(HOLD_NumType) * n;
if memavail > l then
begin
getmem(ArrNum,l);
for i := 1 to arraymax do ArrNum^[i] := 0;
end;
end;
Procedure HOLD_object.done;
var l : longint;
begin
ArrHighVal := 0;
l := sizeof(HOLD_NumType) * arraymax;
IF (ArrNum <> NIL) and (l > 0) then
begin
FreeMem (ArrNum,l);
ArrNum := NIL;
end;
STRA_object.done;
end;
Function HOLD_object.HighNum : HOLD_NumType;
begin
HighNum := ArrHighVal;
end;
Function HOLD_object.findstr(st : string) : HOLD_NdxType;
var i,j : HOLD_NdxType;
begin
j := 0;
i := STRA_object.find(st);
if i > 0 then j := i;
findstr := j;
end;
Function HOLD_object.findnum(Num : HOLD_NumType) : HOLD_NdxType;
var i,j : HOLD_NdxType;
alldone : boolean;
begin
j := 0;
alldone := false;
if Num <= ArrHighVal then
begin
i := 0;
while (i < ArrayUsed) and not alldone do
begin
inc(i);
if ArrNum^[i] = Num then
begin
j := i;
alldone := true;
end;
end;
end;
findnum := j;
end;
Function HOLD_object.count : HOLD_NdxType;
begin
count := ArrayUsed;
end;
Function HOLD_object.fetchNumN (n : HOLD_NdxType) : HOLD_NumType;
begin
if (n > 0) and (n <= ArrayUsed) then
fetchNumN := ArrNum^[n]
else fetchNumN := 0;
end;
Function HOLD_object.fetchStrN (n : HOLD_NdxType) : string;
begin
fetchStrN := STRA_object.fetchstring(n);
end;
Function HOLD_object.fetchN(n : HOLD_NdxType;var st :string; var Num :HOLD_NumType):boolean;
var ok : boolean;
begin
ok := true;
if n > arrayused then ok := false;
Num := fetchNumN(n);
st := fetchStrN(n);
fetchN := ok;
end;
Function HOLD_object.append(st : string; Num : HOLD_NumType) : boolean;
var OK : boolean;
begin
OK := STRA_object.append(st);
if OK then ArrNum^[ArrayUsed] := Num;
if Num > ArrHighVal then ArrHighVal := Num;
append := OK;
end;
Function HOLD_object.storeN (n : HOLD_NdxType; st : string; Num : HOLD_NumType): Boolean;
var OK : boolean;
begin
OK := STRA_object.storeN(n,st);
if OK then ArrNum^[n] := Num;
if Num > ArrHighVal then ArrHighVal := Num;
storeN := OK;
end;
{$R-}
Procedure HOLD_object.swap(i,j : HOLD_NdxType);
var sptr : stringptr;
Num : HOLD_NumType;
begin
STRA_object.swap(i,j);
Num := ArrNum^[i];
ArrNum^[i] := ArrNum^[j];
ArrNum^[j] := Num;
end;
procedure HOLD_object.sort; {sorts based on string value }
var Gap,I,J,N : HOLD_NdxType;
s1,s2 : stringptr;
begin
if arraysorted then exit;
N := STRA_object.count;
Gap := N div 2;
while (Gap > 0) do
begin
I := Gap;
while (I < N) do
begin
J := I - Gap;
s1 := arrayptr^[J+Gap+1].strptr;
s2 := arrayptr^[J+1].strptr;
while (J >= 0) and (s1^ < s2^) do
begin
HOLD_object.swap(J+1,J+Gap+1);
dec(J,Gap);
s1 := arrayptr^[J+Gap+1].strptr;
s2 := arrayptr^[J+1].strptr;
end;
inc(I);
end;
Gap:=Gap div 2;
end;
arraysorted := true;
end;
{$R+}
Procedure HOLD_object.dumpN(n : HOLD_NdxType);
var i : HOLD_NdxType;
begin
if ArrayUsed < 1 then exit;
if n > ArrayUsed then n := arrayused;
writeln('dump used: ',arrayused,' max: ',ArrHighVal);
for i := 1 to n do
begin
writeln(i:4,' str [',arrayptr^[i].fetch,'] num [ ',
ArrNum^[i]:5,' ]');
end;
end;
Procedure HOLD_object.dump;
var i : HOLD_NdxType;
begin
dumpN(9999);
end;
Procedure HOLD_object.save(fname : string);
var i : HOLD_NdxType;
ok : boolean;
s : string;
tx : TFILE_object;
begin
if arrayused < 1 then exit;
tx.init(fname,true);
if comment <> '' then
begin
s := comment;
trim(s);
ok := tx.append('!'+s);
end;
for i := 1 to arrayused do
begin
s := longintstr(ArrNum^[i],8);
trim(s);
ok := tx.append(trimstr(arrayptr^[i].fetch)+','+s);
end;
tx.done;
end;
Procedure HOLD_object.load(fname : string);
var s,st : string;
num : HOLD_NumType;
ok : boolean;
tx : TFILE_object;
begin
comment := '';
tx.init(fname,false);
num := 0;
while tx.fetchnext(s) do
begin
if (num=0) and (s[1]='!') then
begin
delete(s,1,1);
comment := s;
end
else begin
st := GetString(s);
num := strlong(GetString(s));
ok := HOLD_object.append(st,num);
end;
end;
tx.done;
end;